Attribute VB_Name = "modIniFile"

Option Explicit

'Purpose: <BR>
'   INI File Utilities for DP5 Configurations.
'
'Example:
'
'Code:'==========================================================================
'Code:'Quick DP5 INI Utility Guide
'Code:'==========================================================================
'Code:'--------------------------------------------------------------------------
'Code:' All INI data arrays are string arrays and have the form:
'Code:'     varData(Records,Fields)
'Code:' Where:
'Code:'     Records is the Number of INI Section Entries
'Code:'     Fields values are 0=INI Key, 1=INI Data
'Code:'--------------------------------------------------------------------------
'Code:' Note: varSectionNames is a string array of section names. (NOT INI DATA)
'Code:'--------------------------------------------------------------------------
'Code:'--------------------------------------------------------------------------
'Code:'
'Code:'----- HOW DO I ? -----
'Code:'
'Code:'--------------------------------------------------------------------------
'Code:'Read a configuration.
'Code:    varConfig = GetDP5ConfigSection(strFilename, strSection, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Save a configuration.
'Code:    Call SaveDP5ConfigSection(strFilename, strSection, varConfig, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Save ANY INI data array.
'Code:    Call SaveIniDataArray(strFilename, strSection, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Appends semicolons to configuration data.
'Code:    varConfig = AppendSemicolonsToConfig(varConfig)
'Code:'--------------------------------------------------------------------------
'Code:'Set all keys and config data to upper case.
'Code:    varConfig = ConfigToUCASE(varConfig)
'Code:'--------------------------------------------------------------------------
'Code:'Append comments array to configuration data.
'Code:    varData = AppendDP5Comments(varConfig, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Search for data in ANY INI array by key.
'Code:    strData = FindIniData(strKey, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Convert ANY INI data array to a formatted text display string.
'Code:    strDisplaySection = DataArrayString(strSection, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Convert ANY INI data file (all sections) to a formatted text display string.
'Code:    strDisplayIniFile = IniFileString(strFilename)
'Code:'--------------------------------------------------------------------------
'Code:'Read all INI file section names.
'Code:    varSectionNames = GetSectionNames(strFilename)
'Code:'--------------------------------------------------------------------------
'Code:'Extract DP5 commands from a INI data array.
'Code:    varData = GetDP5Commands(varData)
'Code:'--------------------------------------------------------------------------
'Code:'Extract DP5 comments from a INI data array.
'Code:    varComments = GetDP5Comments(varData)
'Code:'--------------------------------------------------------------------------
'Code:'Create a copy of an INI array. Copies keys and data.
'Code:    varDataNew = CreateIniArr(varData) (NOTE: bCopyData = True by default)
'Code:'--------------------------------------------------------------------------
'Code:'Create an empty INI array of varData size.
'Code:    varDataNew = CreateIniArr(varData, False)
'Code:'--------------------------------------------------------------------------
'Code:'Display an INI file section to a list control.
'Code:    Call GetIniListEx2(strFilename, strSection, objList, bRemComments)
'Code:'--------------------------------------------------------------------------

Public varConfig As Variant
Public varComments As Variant
Public varValues As Variant
Public varValComments As Variant

Public varCmdCtrls As Variant
Public varUnitsArray As Variant

Public Const IniSectionVal = "DP5 Configuration Values"
Public Const IniSectionCfg = "DP5 Configuration File"
Public Const IniSectionApp = "DP5 Application Settings"

Public strIniFilename As String

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnBuffer As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

'Purpose: Read INI configuration data and comments array from file.
'Returns INI configuration data array as return value and comments array as parameter.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varComments INI comment data array.
Public Function GetDP5ConfigSection(strFilename As String, strSection As String, ByRef varComments As Variant) As Variant
    Dim varData As Variant
    Dim varConfig As Variant
    
    varData = GetAllIniSettings(strFilename, strSection)  'get the configuration
    If IsEmpty(varData) Then
        GetDP5ConfigSection = varData
        Exit Function
    End If
    varConfig = GetDP5Commands(varData)                     'remove the comments
    varComments = GetDP5Comments(varData)                   'save the comments
    GetDP5ConfigSection = varConfig
End Function

'Purpose: Saves INI data array to file with optional append comments to configuration
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varConfig INI configuration data array.
'Parameter: varComments INI comment data array.
Public Sub SaveDP5ConfigSection(strFilename As String, strSection As String, varConfig As Variant, Optional varComments As Variant)
    Dim varData As Variant
    Dim bAppendComments As Boolean

    If (IsMissing(varComments)) Then
        bAppendComments = False
    Else
        bAppendComments = True
    End If

    If (bAppendComments) Then
        If (IsArray(varComments)) Then      'create new array with comments
            varData = AppendDP5Comments(varConfig, varComments)
            SaveIniDataArray strFilename, strSection, varData
        Else
            bAppendComments = False         'shut off
        End If
    End If
    If (Not bAppendComments) Then       'the configuration has not been saved
        varData = AppendSemicolonsToConfig(varConfig)
        SaveIniDataArray strFilename, strSection, varData
    End If
End Sub

'Purpose: Saves INI data array to file.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varData INI data array.
Public Sub SaveIniDataArray(strFilename As String, strSection As String, varData As Variant)
    Dim strKey As String
    Dim strData As String
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    
    If (Not IsArray(varData)) Then Exit Sub          'if data array is empty cannot save
    idxLRec = LBound(varData, 1)
    idxURec = UBound(varData, 1)
    For idxRecord = idxLRec To idxURec
        strKey = varData(idxRecord, 0)
        strData = varData(idxRecord, 1)
        SaveToIni strFilename, strSection, strKey, strData
    Next
End Sub

'Purpose: Appends semicolons to configuration data array.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function AppendSemicolonsToConfig(varConfig As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim varData As Variant

    If (Not IsArray(varConfig)) Then
        AppendSemicolonsToConfig = Empty
        Exit Function     'if data array is empty cannot save
    End If
    varData = CreateIniArr(varConfig)       'create a working copy of config array
    idxLRec = LBound(varConfig, 1)
    idxURec = UBound(varConfig, 1)
    For idxRecord = idxLRec To idxURec
        If (InStr(1, varData(idxRecord, 1), ";") = 0) Then
            varData(idxRecord, 1) = varData(idxRecord, 1) & ";"
        End If
    Next
    AppendSemicolonsToConfig = varData
End Function

'Purpose: Sets configuration data array keys and data to upper case.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function ConfigToUCASE(varConfig As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim varData As Variant

    If (Not IsArray(varConfig)) Then
        ConfigToUCASE = Empty
        Exit Function     'if data array is empty cannot save
    End If
    varData = CreateIniArr(varConfig)       'create a working copy of config array
    idxLRec = LBound(varConfig, 1)
    idxURec = UBound(varConfig, 1)
    For idxRecord = idxLRec To idxURec
        varData(idxRecord, 0) = UCase(varData(idxRecord, 0))
        varData(idxRecord, 1) = UCase(varData(idxRecord, 1))
    Next
    ConfigToUCASE = varData
End Function

'Purpose: Clears configuration data.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function ClearConfigData(varConfig As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim varData As Variant

    If (Not IsArray(varConfig)) Then
        ClearConfigData = Empty
        Exit Function     'if data array is empty cannot save
    End If
    varData = CreateIniArr(varConfig)       'create a working copy of config array
    idxLRec = LBound(varConfig, 1)
    idxURec = UBound(varConfig, 1)
    For idxRecord = idxLRec To idxURec
        varData(idxRecord, 1) = ""
    Next
    ClearConfigData = varData
End Function

'Purpose: Appends comments to INI data array.
'Returns the Command Key (Field 0) and the Data (Field 1) with comments and semicolons.
'Parameter: varConfig INI configuration data array.
'Parameter: varComments INI comment data array.
Public Function AppendDP5Comments(varConfig As Variant, varComments As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim strKey As String
    Dim strComment As String
    Dim varData As Variant

    If (Not IsArray(varConfig)) Then        'if config array is empty then cannot append
        AppendDP5Comments = Empty
        Exit Function
    ElseIf (Not IsArray(varComments)) Then  'if comment array is empty no need to append
        AppendDP5Comments = varConfig
        Exit Function
    End If
    varData = CreateIniArr(varConfig)       'create a working copy of config array
    idxLRec = LBound(varConfig, 1)          'the config array size is needed
    idxURec = UBound(varConfig, 1)
    For idxRecord = idxLRec To idxURec
        strKey = varData(idxRecord, 0)                  'get the key to search for comment
        strComment = FindIniData(strKey, varComments)   'search the comments array by key
        varData(idxRecord, 1) = varData(idxRecord, 1) & ";" & strComment    'append comment to config
    Next
    AppendDP5Comments = varData
End Function

'Purpose: Find Data for given Key in INI data array.
'Returns the Data (Field 1).
'Parameter: strKey INI item Key.
'Parameter: varData INI data array.
Public Function FindIniData(strKey As Variant, varData As Variant) As String
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim strData As String

   If (Not IsArray(varData)) Then
        FindIniData = ""
        Exit Function
    End If

    idxLRec = LBound(varData, 1)
    idxURec = UBound(varData, 1)
    strData = ""
    For idxRecord = idxLRec To idxURec
        If (StrComp(strKey, varData(idxRecord, 0), vbTextCompare) = 0) Then
            strData = varData(idxRecord, 1)
            Exit For
        End If
    Next
    FindIniData = strData
End Function

'Purpose: Creates a formatted display string of INI file Section.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
Public Function SectionString(strFilename As String, strSection As String) As String
    Dim varData As Variant
    Dim idxKey As Long
    Dim strData As String
    
    varData = GetAllIniSettings(strFilename, strSection)
    strData = vbNewLine & "[" & strSection & "]" & vbNewLine
    If IsArray(varData) Then
        For idxKey = LBound(varData, 1) To UBound(varData, 1)
            strData = strData & varData(idxKey, 0) & "=" & varData(idxKey, 1) & vbNewLine
        Next
    End If
    SectionString = strData
End Function

'Purpose: Creates a formatted display string of a INI data array.
'Parameter: strSection INI file Section.
'Parameter: varData INI data array.
Public Function DataArrayString(strSection As String, varData As Variant) As String
    Dim idxKey As Long
    Dim strData As String
    
    strData = vbNewLine & "[" & strSection & "]" & vbNewLine
    If IsArray(varData) Then
        For idxKey = LBound(varData, 1) To UBound(varData, 1)
            strData = strData & varData(idxKey, 0) & "=" & varData(idxKey, 1) & vbNewLine
        Next
    End If
    DataArrayString = strData
End Function

'Purpose: Creates a formatted display string of INI file.
'Parameter: strFilename INI Filename.
Public Function IniFileString(strFilename As String) As String
    Dim varSections As Variant
    Dim idxSection As Long
    Dim strSection As String
    Dim strData As String
    
    IniFileString = ""
    strData = ""
    varSections = GetSectionNames(strFilename)
    If (IsArray(varSections)) Then
        For idxSection = LBound(varSections) To UBound(varSections)
            strSection = varSections(idxSection)
            strData = strData & SectionString(strFilename, strSection)
        Next
    Else
        strSection = varSections
        If (Len(strSection) > 0) Then
            strData = SectionString(strFilename, strSection)
        End If
    End If
    IniFileString = strData
End Function

'Purpose: Returns the INI file section names.
'Parameter: strFilename INI Filename.
Public Function GetSectionNames(strFilename As String) As Variant
    Dim lngRetVal As Long
    Dim strBuffer As String
    Dim strSections() As String
    Dim strSectionName As String '
    Dim idxSection As Long
    Dim lPos As Long
    Dim lNull As Long
    Dim lBufSize As Long

    idxSection = 0
    lPos = 1
    strBuffer = Space(2048)
    lngRetVal = GetPrivateProfileSectionNames(strBuffer, Len(strBuffer), strFilename)
    lBufSize = Len(strBuffer)
    Do While (lPos < lBufSize)
        lNull = InStr(lPos, strBuffer, vbNullChar)
        If (lNull <> lPos) Then
            ReDim Preserve strSections(0 To idxSection) As String
            strSections(idxSection) = Mid$(strBuffer, lPos, lNull - lPos)
            idxSection = idxSection + 1
            lPos = lNull + 1
        Else
            Exit Do
        End If
    Loop
    GetSectionNames = strSections
End Function

'Purpose: Removes comments from INI section data.
'Returns the Command Key (Field 0) and the Command Setting (Field 1) without semicolons.
'Parameter: varData INI Section array.
'Remarks: The comment whitespace is not trimmed.
Public Function GetDP5Commands(ByRef varData As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim lPos As Long
    Dim varConfig As Variant

    If (Not IsArray(varData)) Then
        GetDP5Commands = Empty
        Exit Function
    End If
    varConfig = CreateIniArr(varData)
    idxLRec = LBound(varConfig, 1)
    idxURec = UBound(varConfig, 1)
    For idxRecord = idxLRec To idxURec
        lPos = InStr(varConfig(idxRecord, 1), ";")
        If lPos = 1 Then    'not data only comments
           varConfig(idxRecord, 1) = ""
        ElseIf (lPos > 1) Then
           varConfig(idxRecord, 1) = Left(varConfig(idxRecord, 1), lPos - 1)
        Else
            'not found
        End If
    Next
    GetDP5Commands = varConfig
End Function

'Purpose: Extracts comments from INI section data.
'Returns the Command Key (Field 0) and the Comments (Field 1) without semicolons.
'Parameter: varData INI Section array.
'Remarks: The comment whitespace is not trimmed.
Public Function GetDP5Comments(ByRef varData As Variant) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim lPos As Long
    Dim varComments As Variant

    If (Not IsArray(varData)) Then
        GetDP5Comments = Empty
        Exit Function
    End If
    varComments = CreateIniArr(varData)
    idxLRec = LBound(varComments, 1)
    idxURec = UBound(varComments, 1)
    For idxRecord = idxLRec To idxURec
        lPos = InStr(varComments(idxRecord, 1), ";")
        If (lPos > 0) Then
           varComments(idxRecord, 1) = Mid(varComments(idxRecord, 1), lPos + 1)
        Else    'not found
            varComments(idxRecord, 1) = ""
        End If
    Next
    GetDP5Comments = varComments
End Function


'Purpose: Creates INI data array of existing array size.  Optional copy of existing data.
'Returns a INI data array.
'Parameter: varData INI configuration data array.
'Parameter: bCopyData Copy existing data array.
Public Function CreateIniArr(varData As Variant, Optional bCopyData As Boolean = True) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim idxLFld As Long
    Dim idxUFld As Long
    Dim idxField As Long
    Dim lPos As Long
    Dim strData() As String
    Dim strKey As String
    Dim strComment As String

    If (Not IsArray(varData)) Then        'if data array is empty then cannot create new array
        CreateIniArr = Empty
        Exit Function
    End If
    idxLRec = LBound(varData, 1)      'the config array size is needed
    idxURec = UBound(varData, 1)
    idxLFld = LBound(varData, 2)
    idxUFld = UBound(varData, 2)
    ReDim strData(idxURec, idxUFld)     'create new working array to hold combined data and comments
    If (bCopyData) Then
        For idxRecord = idxLRec To idxURec  'copy the config to the working array
            For idxField = idxLFld To idxUFld
                strData(idxRecord, idxField) = varData(idxRecord, idxField)
            Next
        Next
    End If
    CreateIniArr = strData
End Function

'Purpose: Creates INI data array of existing array size.  Optional copy of existing data.
'Returns a INI data array.
'Parameter: varData INI configuration data array.
'Parameter: bCopyData Copy existing data array.
Public Function CopyIniArr(varData As Variant, Optional bCopyEmpty As Boolean = True) As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim idxLFld As Long
    Dim idxUFld As Long
    Dim idxField As Long
    Dim lPos As Long
    Dim strData() As String
    Dim strKey As String
    Dim strComment As String
    Dim idxNotEmpty As Long
    Dim idxNew As Long

    If (Not IsArray(varData)) Then        'if data array is empty then cannot create new array
        CopyIniArr = Empty
        Exit Function
    End If
    idxLRec = LBound(varData, 1)      'the config array size is needed
    idxURec = UBound(varData, 1)
    idxLFld = LBound(varData, 2)
    idxUFld = UBound(varData, 2)
    If (bCopyEmpty) Then
        ReDim strData(idxURec, idxUFld)     'create new working array to hold combined data and comments
        For idxRecord = idxLRec To idxURec  'copy the config to the working array
            For idxField = idxLFld To idxUFld
                strData(idxRecord, idxField) = varData(idxRecord, idxField)
            Next
        Next
    Else
        idxNotEmpty = -1
        For idxRecord = idxLRec To idxURec  'count the working array valid values
            If (Len(Trim(varData(idxRecord, 1))) > 0) Then idxNotEmpty = idxNotEmpty + 1
        Next
        If (idxNotEmpty >= 0) Then
            idxNew = 0
            ReDim strData(idxNotEmpty, idxUFld)     'create new working array to hold combined data and comments
            For idxRecord = idxLRec To idxURec  'copy the config to the working array
                If (Len(Trim(varData(idxRecord, 1))) > 0) Then
                    If (idxNew <= idxNotEmpty) Then
                        For idxField = idxLFld To idxUFld
                            strData(idxNew, idxField) = varData(idxRecord, idxField)
                        Next
                        idxNew = idxNew + 1
                    End If
                End If
            Next
        End If
    End If
    CopyIniArr = strData
End Function

'Purpose: Reads Ini Section, saves to List control.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI Section requested.
'Parameter: objList INI Section display list.
'Parameter: bRemComments Remove comments from section data.
Public Sub GetIniListEx2(strFilename As String, strSection As String, objList As Object, bRemComments As Boolean)
    Dim varData As Variant
    Dim idxLRec As Long
    Dim idxURec As Long
    Dim idxRecord As Long
    Dim strItem As String
    Dim lPos As Long

    objList.Clear
    varData = GetAllIniSettings(strFilename, strSection)
    If IsEmpty(varData) Then Exit Sub
    idxLRec = LBound(varData, 1)
    idxURec = UBound(varData, 1)
    For idxRecord = idxLRec To idxURec
        strItem = varData(idxRecord, 0) & "=" & varData(idxRecord, 1)
        If (bRemComments) Then
            lPos = InStr(strItem, ";")
            If lPos = 1 Then
               strItem = ""
            ElseIf lPos > 1 Then
               strItem = Left$(strItem, lPos - 1)
            End If
        End If
        objList.AddItem strItem
    Next
    objList.ListIndex = objList.TopIndex
End Sub

Public Sub SaveToIni(strFilename As String, strSection As String, strKey As String, strData As String)
    Dim lngRetVal As Long
    lngRetVal = WritePrivateProfileString(strSection, strKey, strData, strFilename)
End Sub

Public Function GetFromIni(strFilename As String, strSection As String, strKey As String, Optional strDefault As String) As String
    Dim lngRetVal As Long
    Dim lngBuffSz As Long
    Dim strBuff As String
    
    strBuff = Space(255)
    lngBuffSz = 255
    lngRetVal = GetPrivateProfileString(strSection, strKey, strDefault, strBuff, lngBuffSz, strFilename)
    lngBuffSz = InStr(1, strBuff, Chr(0), vbBinaryCompare)
    If lngBuffSz > 0 Then
        GetFromIni = Trim(Left(strBuff, lngBuffSz - 1))
    Else
        GetFromIni = strBuff
    End If
End Function

Public Function GetAllIniSettings(strFilename As String, Section As String) As Variant
    Dim lRet As Long
    Dim strTemp As String
    Dim Table() As String
    Dim Table2() As String
    Dim iPnt As Integer
    Dim iPnt2 As Integer
    Dim iPosit As Integer
    
    strTemp = Space(32567)
    lRet = GetPrivateProfileSection(Section, strTemp, Len(strTemp), strFilename)
    iPnt = 0
    'For Redim+Preserve tables only the las index can be changed
    If Left(strTemp, 2) = Chr$(0) & Chr$(0) Then
        Exit Function
    End If
    
    If (lRet = 0) Then
        Exit Function
    End If
    
    Do While Left(strTemp, 1) <> Chr$(0)
        ReDim Preserve Table(1, iPnt)
        iPosit = InStr(strTemp, "=")
        Table(0, iPnt) = Left$(strTemp, iPosit - 1)
        strTemp = Mid$(strTemp, iPosit + 1)
        iPosit = InStr(strTemp, Chr$(0))
        Table(1, iPnt) = Left$(strTemp, iPosit - 1)
        strTemp = Mid$(strTemp, iPosit + 1)
        iPnt = iPnt + 1
    Loop
    ReDim Table2(iPnt - 1, 1)
    
    For iPnt2 = 0 To iPnt - 1
        Table2(iPnt2, 0) = Table(0, iPnt2)
        Table2(iPnt2, 1) = Table(1, iPnt2)
    Next
    
    GetAllIniSettings = Table2
End Function

Public Sub GetIniList(strFilename As String, strSection As String, objList As Object)
    Dim varAllIni As Variant
    Dim i As Integer
    Dim j As Integer
    Dim idxLRec As Long
    Dim idxLFld As Long
    Dim idxURec As Long
    Dim idxUFld As Long
    
    objList.Clear
    varAllIni = GetAllIniSettings(strFilename, strSection)
    If IsEmpty(varAllIni) Then Exit Sub

    idxLRec = LBound(varAllIni, 1)
    idxLFld = LBound(varAllIni, 2)
    idxURec = UBound(varAllIni, 1)
    idxUFld = UBound(varAllIni, 2)

    For i = idxLRec To idxURec
         objList.AddItem varAllIni(i, 1)
    Next
    objList.ListIndex = objList.TopIndex
End Sub

'------------------------------------------------------
' Function:   ValidFilename as string
' arguments:  strFilename         a filename
' Result: ValidFilename returns a valid filename
'-------------------------------------------------------
Function ValidFilename(strFilename As String) As String
    Dim i As Integer
    Dim strFname As String
    Dim legalChar As String
    ValidFilename = strFilename
    strFname = Trim(strFilename)       'remove white space
    ' Remove for illegal characters
    legalChar = " !#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~.üäöÄÖÜß"
    For i = 1 To Len(strFname)
        If InStr(legalChar, UCase(Mid(strFname, i, 1))) = 0 Then
            Mid(strFname, i, 1) = " "
        End If
    Next i
    ValidFilename = strFname
End Function

Public Sub SaveApplicationSettings(frm As Form, Optional AppSet As Boolean = True, _
                                                Optional CfgSet As Boolean = True, _
                                                Optional ComSet As Boolean = True)
    Dim strFilename As String
    strFilename = App.Path & "\" & App.EXEName & ".ini"
    
    If (AppSet) Then
        'Application Settings
        SaveToIni strFilename, IniSectionApp, frm.Name & "_Top", frm.Top
        SaveToIni strFilename, IniSectionApp, frm.Name & "_Left", frm.Left
    End If
    
    If (ComSet) Then
        'Communications Interface Settings
        SaveToIni strFilename, IniSectionApp, "CurrentInterface", CStr(CurrentInterface)
        SaveToIni strFilename, IniSectionApp, "ComPort", CStr(ComPort)
    End If
End Sub

Public Sub LoadApplicationSettings(frm As Form, Optional AppSet As Boolean = True, _
                                                Optional CfgSet As Boolean = True, _
                                                Optional ComSet As Boolean = True)
    Dim strFilename As String
    strFilename = App.Path & "\" & App.EXEName & ".ini"
    
    If (AppSet) Then
        'Application Settings
        frm.Top = GetFromIni(strFilename, IniSectionApp, frm.Name & "_Top", frm.Top)
        frm.Left = GetFromIni(strFilename, IniSectionApp, frm.Name & "_Left", frm.Left)
    End If
        
    If (ComSet) Then
        'Communications Interface Settings
        CurrentInterface = GetFromIni(strFilename, IniSectionApp, "CurrentInterface", USB)
        ComPort = GetFromIni(strFilename, IniSectionApp, "ComPort", 1)
    End If
End Sub

'Saves all INI Settings - NOTE:OVERWRITES ENTIRE SECTION - Use with caution!
'Useage - copy all section settings IN ORDER to Settings array, overwrites section settings
'Settings Variant Type of String Array -> Setting(Index,0),Setting(Index,1) -> 0=key,1=data
Public Sub SaveAllIniSettings(strFilename As String, Section As String, Settings As Variant)
    Dim lngRetVal As Long
    Dim strData As String
    Dim strSettings As String
    Dim strNULL As String
    Dim idxSetting As Long
    Dim strSep As String
    
    strNULL = Chr$(0)
    If (Not IsArray(Settings)) Then Exit Sub
    If (UBound(Settings, 2) <> 1) Then Exit Sub
    
    For idxSetting = LBound(Settings, 1) To UBound(Settings, 1)
        strData = CStr(Settings(idxSetting, 1))
        If (InStr(strData, ";") > 0) Then
            strSep = ""
        Else
            strSep = ";"
        End If
        strSettings = strSettings & CStr(Settings(idxSetting, 0)) & "=" & strData & strSep & strNULL
    Next
    strSettings = strSettings & strNULL
    lngRetVal = WritePrivateProfileSection(Section, strSettings, strFilename)
End Sub

Public Sub DeleteIniSetting(strFilename As String, Section As String, Optional Key As String = "")
    Dim lRet As Long
    If Key = "" Then
        lRet = WritePrivateProfileString(Section, vbNullString, vbNullString, strFilename)
    Else
        lRet = WritePrivateProfileString(Section, Key, vbNullString, strFilename)
    End If
End Sub

